home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd25.zip / MUTT2.ZIP / POPUP.MUT < prev    next >
Lisp/Scheme  |  1992-11-09  |  4KB  |  110 lines
  1.   ;; popup.mut : put a popup window on the screen
  2.   ;; The window is transient - it goes away on redraw.
  3.   ;; ME knows nothing about the window
  4.   ;; C Durland
  5.  
  6. (include max.mut)
  7.  
  8. (const
  9.   UPPER-LEFT-CORNER "." UPPER-RIGHT-CORNER "."
  10.   LOWER-LEFT-CORNER "`" LOWER-RIGHT-CORNER "'"
  11.   LEFT-SIDE         "|" RIGHT-SIDE         "|"
  12.   HEDGES  "--------------------------------------------------------------------------------"
  13.   BLANKS "                                                                            "
  14. )
  15.  
  16. (small-int ulrow ulcol brow bcol)
  17.  
  18. (defun
  19.   popup-window (int row col width length)
  20.   {
  21.     (int j r)
  22.  
  23.     (ulrow (brow (+ row 1)))(ulcol (bcol (+ col 1)))
  24.     (move-cursor row col)
  25.     (puts UPPER-LEFT-CORNER (extract-elements HEDGES 0 width)
  26.       UPPER-RIGHT-CORNER)
  27.     (for {(r ulrow)(j 0)} (< j length) {(+= j 1)(+= r 1)}
  28.     {
  29.       (move-cursor r col)
  30.       (puts LEFT-SIDE (extract-elements BLANKS 0 width) RIGHT-SIDE)
  31.     })
  32.     (move-cursor r col)
  33.     (puts LOWER-LEFT-CORNER (extract-elements HEDGES 0 width)
  34.       LOWER-RIGHT-CORNER)
  35.   }
  36.   wputs    (string msg)
  37.   {
  38.     (move-cursor brow bcol)(puts msg)
  39.     (+= brow 1)
  40.   }
  41. )
  42.  
  43. ;******************************************************************************;
  44. ;***                                                                        ***;
  45. ;**                           . . M E N U - B O X                            **;
  46. ;***                                                                        ***;
  47. ;******************************************************************************;
  48.  
  49. ; Desc: Draw one or more boxes justified to the top right corner of the screen.
  50. ;       Each parameter represents a line in the box. 
  51. ;       The box width is ajusted to the max width of the lines to be
  52. ;       contained in the current box.
  53. ;       If a box does not fit vertically, it is broken in 2 boxes.
  54. ;       Some lines (parameters) have special effect:
  55. ;           ''      Close current box and open a new box in the next column.
  56. ;                       To have a blank line, just use ' '.
  57. ;           '-'     Is replaced by a solid line across the box.
  58. ;           '>xxxx' xxxx is centered in the box.
  59. ;       
  60. ; Use : For popup menus
  61. ; Call: (menu-box text text ...)
  62. ; Author: Orginal idea and code from Michel St-Louis, rewritten by C Durland
  63.  
  64. (const
  65.   BOX-OVERLAP     2        ;; 1 (share borders) or 2 (don't share)
  66.   BOX-MAX-LENGTH 3        ;; 4 (don't cover modeline), 3 (go ahead)
  67. )
  68.  
  69. (defun menu-box
  70. {
  71.   (array small-int box-width 10 box-length 10)
  72.   (int boxes i j k w l max-length left-edge total-width)
  73.  
  74.   (max-length (- (screen-length) BOX-MAX-LENGTH))
  75.   (for (total-width (boxes (j (w (l 0))))) (< j (nargs)) (+= j 1)
  76.     {
  77.       (w (max w (length-of (arg j))))
  78.       (if (or (== "" (arg j)) (== (+= l 1) max-length))    ;; need another box
  79.     {
  80.       (box-width boxes w)(box-length boxes l)(+= boxes 1)
  81.       (+= total-width (+ w BOX-OVERLAP))
  82.       (w (l 0))
  83.     })
  84.     })
  85.   (box-width boxes w)(box-length boxes l)(+= boxes 1)
  86.   (+= total-width (+ w 2))
  87.  
  88.   (left-edge (- (screen-width) total-width))
  89.   (for (i (j 0)) (< i boxes) (+= i 1)
  90.     {
  91.       (popup-window 0 left-edge (box-width i) (box-length i))
  92.       (+= left-edge (box-width i) BOX-OVERLAP)
  93.       (if (== "" (arg j)) (+= j 1))
  94.  
  95.       (for (k 0) (< k (box-length i)) { (+= k 1)(+= j 1) }
  96.         {
  97.       (wputs
  98.         (cond
  99.           (== '-' (arg j)) (extract-elements HEDGES 0 (box-width i))
  100.           (== '>' (extract-elements (arg j) 0 1))
  101.               (concat
  102.             (extract-elements BLANKS 0
  103.                 (/ (- (box-width i) (length-of (arg j))) 2))
  104.             (extract-elements (arg j) 1 100))
  105.           TRUE  (arg j)
  106.         ))
  107.     })
  108.     })
  109. })
  110.